home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
tool-inc.zip
/
DOSIO.INC
< prev
next >
Wrap
Text File
|
1989-06-02
|
6KB
|
245 lines
(*
* Copyright 1987, 1989 Samuel H. Smith; All rights reserved
*
* This is a component of the ProDoor System.
* Do not distribute modified versions without my permission.
* Do not remove or alter this notice or any other copyright notice.
* If you use this in your own program you must distribute source code.
* Do not use any of this in a commercial product.
*
*)
(*
* dosio - library for interface to dos v2 file access functions
*
* usage:
*
* fd := dos_create('name',attributes)
* if dos_unlink('name') = dos_error then ...
* fd := dos_open('name',open_(read write update))
* if dos_close(fd) = dos_error then ...
* count := dos_read(fd,buffer,sizeof(buffer))
* count := dos_write(fd,buffer,sizeof(buffer))
* integer_pos := dos_seek(fd,seek_(start cur end),integer_offset)
* real_pos := dos_lseek(fd,seek_*,real_offset)
* dos_file_times(fd,time_(set get),time,date);
*
*)
type
dos_filename = string[64];
dos_handle = integer;
dos_seek_methods = (seek_start,
seek_cur,
seek_end);
dos_time_functions = (time_get,
time_set);
const
dos_error = -1;
stdin = 0;
stdout = 1;
stderr = 2;
open_read = $40; {deny_nothing, allow_read}
open_write = $41; {deny_nothing, allow_write}
open_update = $42; {deny_nothing, allow_read+write}
var
dos_regs: registers;
dos_name: dos_filename;
dos_message: string[90];
procedure dos_call(var regs: registers);
begin
msdos(regs);
if (regs.flags and 1) = 1 then
begin
case regs.ax of
1: dos_message := 'invalid subfunction code';
2: dos_message := 'file not found';
3: dos_message := 'directory not found';
4: dos_message := 'too many open files';
5: dos_message := 'access denied';
6: dos_message := 'invalid file handle';
else dos_message := 'unknown DOS error';
end;
writeln('ERROR: ',dos_message,' ( ',dos_name,')');
regs.ax := dos_error;
end;
end;
function dos_create(name: dos_filename;
attrib: integer): dos_handle;
begin
dos_regs.ax := $3c00;
dos_regs.ds := seg(dos_name);
dos_regs.dx := ofs(dos_name)+1;
dos_regs.cx := attrib;
dos_name := name + #0;
dos_call(dos_regs);
dos_create := dos_regs.ax;
end;
function dos_unlink(name: dos_filename): dos_handle;
begin
dos_regs.ax := $4100;
dos_regs.ds := seg(dos_name);
dos_regs.dx := ofs(dos_name)+1;
dos_name := name + #0;
dos_call(dos_regs);
dos_unlink := dos_regs.ax;
end;
(* dos_open(name,mode) -> handle or dos_error *)
function dos_open(name: dos_filename;
mode: integer): dos_handle;
var
try: integer;
const
retry_count = 3;
begin
dos_name := name + #0;
for try := 1 to retry_count do
begin
dos_regs.ax := $3d00 + mode;
dos_regs.ds := seg(dos_name);
dos_regs.dx := ofs(dos_name)+1;
msdos(dos_regs);
dos_open := dos_regs.ax;
if (dos_regs.flags and 1) = 0 then
exit;
end;
dos_open := dos_error;
end;
function dos_close(handle: dos_handle): dos_handle;
begin
dos_regs.ax := $3e00;
dos_regs.bx := handle;
dos_call(dos_regs);
dos_close := dos_regs.ax;
end;
(* read(fd,buffer,bytecount) -> bytesread or dos_error *)
function dos_read(handle: dos_handle;
var buffer;
bytes: integer): dos_handle;
begin
dos_regs.ax := $3f00;
dos_regs.bx := handle;
dos_regs.cx := bytes;
dos_regs.ds := seg(buffer);
dos_regs.dx := ofs(buffer);
dos_call(dos_regs);
dos_read := dos_regs.ax;
end;
(* write(fd,buffer,bytecount) -> byteswritten or dos_error *)
function dos_write(handle: dos_handle;
var buffer;
bytes: integer): dos_handle;
begin
dos_regs.ax := $4000;
dos_regs.bx := handle;
dos_regs.cx := bytes;
dos_regs.ds := seg(buffer);
dos_regs.dx := ofs(buffer);
dos_call(dos_regs);
dos_write := dos_regs.ax;
if dos_regs.ax <> bytes then
writeln('ERROR: write failed (disk full?)');
end;
(* seek(fd,method,offset) -> new file position *)
function dos_seek(handle: dos_handle;
method: dos_seek_methods;
offset: integer): dos_handle;
begin
dos_regs.ax := $4200 + ord(method);
dos_regs.bx := handle;
dos_regs.dx := offset;
dos_regs.cx := 0;
dos_call(dos_regs);
dos_seek := dos_regs.ax;
end;
(* lseek(fd,method,roffset) -> new file position *)
function dos_lseek(handle: dos_handle;
method: dos_seek_methods;
offset: real): real;
var
dxv: real;
begin
dos_regs.ax := $4200 + ord(method);
dos_regs.bx := handle;
dos_regs.cx := itrunc(offset / 65536.0);
dxv := offset - 65536.0*int(dos_regs.cx);
if dxv > int($7fff) then
dxv := dxv - 65536.0;
if dxv = $8000 then
dos_regs.dx := $8000
else
dos_regs.dx := itrunc(dxv);
dos_call(dos_regs);
if dos_regs.ax = dos_error then
dos_lseek := dos_error
else
dos_lseek := int(dos_regs.dx) * 65536.0 +
int(dos_regs.ax shr 1) * 2.0 +
int(dos_regs.ax and 1);
end;
(* dos_file_times(fd,time_(set get),time,date); *)
procedure dos_file_times(fd: dos_handle;
func: dos_time_functions;
var time: integer;
var date: integer);
begin
dos_regs.ax := $5700 + ord(func);
dos_regs.bx := fd;
dos_regs.cx := time;
dos_regs.dx := date;
dos_call(dos_regs);
time := dos_regs.cx;
date := dos_regs.dx;
end;